home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / pascal / tpb4_src.zip / FILEMNU1.PAS < prev    next >
Pascal/Delphi Source File  |  1988-09-13  |  13KB  |  433 lines
  1. { TPBoard 4.2 Copyright (c) 1987,88 by Jon Schneider & Rick Petersen  
  2.   Portions Copyright (c) 1986,87 by Steve Fox and Les Archambault  
  3.   
  4.   Last modified  ::  7-3-88 8:22 pm 
  5. }
  6.  
  7. {$R-}                             {Range checking off}
  8. {$B-}                             {Boolean complete evaluation off}
  9. {$S-}                             {Stack checking off}
  10. {$I+}                             {I/O checking on}
  11. {$N-}                             {No numeric coprocessor}
  12.  
  13. Unit FileMnu1;
  14.  
  15. Interface
  16.  
  17. Uses
  18.   TPCrt, Dos, Globals, Core1,
  19.   Core2, TPSTRING, TPDOS, Dirs;
  20.   
  21.   
  22. procedure ArcLbr;
  23.  
  24. procedure toggle_st_switch;
  25.  
  26. procedure file_area_change(req : DosFileName);
  27.  
  28. procedure directory(disp : Boolean);
  29.  
  30.  
  31.   {=========================================================================}
  32.   
  33.   
  34. Implementation
  35.  
  36.  
  37.   procedure ArcLbr;
  38.   
  39.   var
  40.     Req             : DosFileName;
  41.     This            : FilePtr;
  42.     Extension       : string[4];
  43.     OK              : Boolean;
  44.     
  45.   begin
  46.     if in_library then
  47.       begin
  48.         SetSect(SetName);         { Close file }
  49.         {$I-}
  50.         Close(libr_file) {$I+} ;
  51.         OK := (IoResult = 0);
  52.         SetSect(HomName);
  53.         while LibBase <> nil do   { Clean out old list }
  54.           begin
  55.             This := LibBase;
  56.             LibBase := LibBase^.next; { Go to next on chain }
  57.             Dispose(This)         { Reclaim space }
  58.           end;
  59.         in_library := False;
  60.         WriteLn(Com, 'Library ', LibReq, ' closed.')
  61.       end
  62.     else if in_arc then
  63.       begin
  64.         SetSect(SetName);         { Close file }
  65.         {$I-}
  66.         Close(arc_file);
  67.         {$I+}
  68.         OK := (IoResult = 0);
  69.         SetSect(HomName);
  70.         while ArcBase <> nil do   { Clean out old list }
  71.           begin
  72.             This := ArcBase;
  73.             ArcBase := ArcBase^.next; { Go to next on chain }
  74.             Dispose(This)         { Reclaim space }
  75.           end;
  76.         in_arc := False;
  77.         WriteLn(Com, 'Arc File ', ArcReq, ' closed.')
  78.       end
  79.     else
  80.       begin
  81.         Req := prompt('Arc/Library name', 12, 'ES');
  82.         Delete(Req, 1, Pos(':', Req));
  83.         if (Pos('.', Req) = 0) and (Req <> ' ') then
  84.           begin
  85.             SetSect(SetName);
  86.             Extension := '';
  87.             if ExistFile(Req+'.ARC') then
  88.               Extension := '.ARC'
  89.             else if ExistFile(Req+'.LBR') then
  90.               Extension := '.LBR'
  91.             else if ExistFile(Req+'.ARK') then
  92.               Extension := '.ARK';
  93.             if Extension <> '' then
  94.               Req := Req+Extension;
  95.             SetSect(HomName)
  96.           end;
  97.         if Req = ' ' then
  98.           begin
  99.           end
  100.         else if JustExtension(Req) = 'LBR' then
  101.           begin
  102.             LibReq := Req;
  103.             LibReadDir(LibEntries, LibSpace, LibBase);
  104.             if not in_library then
  105.               WriteLn(Com, 'Cannot open ', LibReq, '.')
  106.           end
  107.         else if (JustExtension(Req) = 'ARC') or (JustExtension(Req) = 'ARK') then
  108.           begin
  109.             ArcReq := Req;
  110.             ArcReadDir(ArcEntries, ArcSpace, ArcBase);
  111.             if not in_arc then
  112.               WriteLn(Com, 'Cannot open ', ArcReq, '.')
  113.           end
  114.         else
  115.           WriteLn(Com, 'Couldn''t locate any ARC, ARK, or LBR files by that name.');
  116.       end;
  117.   end;
  118.   
  119.   
  120.   
  121.   procedure toggle_st_switch;
  122.     { Toggle file size display }
  123.     
  124.   begin
  125.     WriteLn(Com);
  126.     st_switch := not st_switch;
  127.     Write(Com, 'File sizes will be shown in ');
  128.     if st_switch then
  129.       WriteLn(Com, 'bytes, where "k" is 1024.')
  130.     else
  131.       WriteLn(Com, 'minutes and seconds of transfer time.')
  132.   end;
  133.   
  134.   
  135.   
  136.   procedure file_area_change(Req : DosFileName);
  137.     { View and set up file area for use }
  138.     
  139.   const
  140.     col_width       = 16;
  141.     
  142.   var
  143.     drive           : Str3;
  144.     col_count,
  145.     col_limit,
  146.     conf_num,
  147.     line_count,
  148.     section_count   : Integer;
  149.     This            : SectPtr;
  150.     pr              : StrPr;
  151.     SameSect, OK    : Boolean;
  152.     
  153.     
  154.     procedure display_long;
  155.     
  156.     begin
  157.       This := SectBase;
  158.       WriteLn(Com);
  159.       line_count := 2;
  160.       section_count := 1;
  161.       while (not brk) and (This <> nil) do
  162.         begin
  163.           conf_num := This^.SectConf;
  164.           if (user_rec.access >= This^.SectAccs) or (test_bit(user_rec.conf_flags,
  165.             conf_num)) then
  166.             begin
  167.               WriteLn(Com, hi, yellow, intstr(section_count, 2), ' ',
  168.                 pad(This^.SectName, 13), low, green, This^.SectDesc);
  169.               Inc(section_count);
  170.             end;
  171.           This := This^.next;
  172.           if user_rec.lines <> 99 then
  173.             begin
  174.               Inc(line_count);
  175.               if line_count mod user_rec.lines = 0 then
  176.                 pause;
  177.             end;
  178.         end;
  179.       Write(Com, hi, cyan);
  180.       WriteLn(Com);
  181.     end;
  182.     
  183.     procedure display_short;
  184.     
  185.     var
  186.       wrap_on_next    : Boolean;
  187.       pad_count       : Byte;
  188.       
  189.     begin
  190.       WriteLn(Com);
  191.       abort := False;
  192.       col_count := 0;
  193.       This := SectBase;
  194.       Write(Com, hi, yellow);
  195.       section_count := 1;
  196.       while (not brk) and (This <> nil) do
  197.         begin
  198.           conf_num := This^.SectConf;
  199.           if (user_rec.access >= This^.SectAccs) or (test_bit(user_rec.
  200.             conf_flags, conf_num)) then
  201.             begin
  202.               Inc(col_count);
  203.               wrap_on_next := (0 = col_count mod col_limit);
  204.               if wrap_on_next then
  205.                 pad_count := 1
  206.               else
  207.                 pad_count := 13;
  208.               Write(Com, yellow, intstr(section_count, 2), cyan, ' ',
  209.                 pad(This^.SectName, pad_count));
  210.               if wrap_on_next then
  211.                 WriteLn(Com);
  212.               Inc(section_count);
  213.             end;
  214.           This := This^.next
  215.         end;
  216.       Write(Com, cyan);
  217.       if 0 <> col_count mod col_limit then
  218.         WriteLn(Com);
  219.       WriteLn(Com);
  220.     end;
  221.     
  222.   begin                           {file area change}
  223.     SameSect := False;
  224.     section_count := 1;
  225.     col_limit := max(1, user_rec.columns div col_width);
  226.     if Req = '' then
  227.       begin
  228.         pr := white+'Enter Area Name or #'+cyan;
  229.         WriteLn(Com);
  230.         Req := prompt(pr, 12, 'ES?M');
  231.         if Req = ' ' then
  232.           begin
  233.             Req := SectReq;       {default to current setting}
  234.             SameSect := True;
  235.           end
  236.         else
  237.           SameSect := False;
  238.       end;
  239.     while (not new_dir) and (Online) and (not SameSect) do
  240.       begin
  241.         This := SectBase;
  242.         if (Req = '?') or (Req = '/') then
  243.           begin
  244.             WriteLn(Com);
  245.             WriteLn(Com, 'Available file areas:');
  246.             display_short;
  247.             repeat
  248.               Req := prompt(pr+' ["?" for Descriptions]', 12, 'ES?');
  249.               if (Req = '?') or (Req = '/') then
  250.                 display_long;
  251.             until (Req <> '?') and (Req <> '/');
  252.             if Req = ' ' then
  253.               Req := SectReq;
  254.           end
  255.         else if Req <> '' then
  256.           begin
  257.             FindSect(Req, drive, OK);
  258.             if OK then
  259.               begin
  260.                 SectReq := Req;
  261.                 SetDrv := drive;
  262.                 if (Req = 'SYSTEM') and (HomName[1] = drive[1]) then
  263.                   SetName := HomName
  264.                 else
  265.                   begin
  266.                     SetName := drive;
  267.                     if (Length(HomName) > 3) and (drive = HomDrv) then
  268.                       begin
  269.                         SetName := SetName+Copy(HomName, 4, Length(HomName));
  270.                         SetName := SetName+'\';
  271.                       end;
  272.                     if Pos(':', Req) = 2 then
  273.                       SetName := SetName+Copy(Req, 3, Length(Req))
  274.                     else
  275.                       SetName := SetName+Req;
  276.                   end;
  277.                 ReadDir(DirEntries, DirSpace, DirBase);
  278.               end
  279.             else
  280.               begin
  281.                 WriteLn(Com, '"', Req, '" not found.  Available file areas:');
  282.                 display_short;
  283.                 repeat
  284.                   Req := prompt(pr+' ["?" for Descriptions]', 12, 'ES?');
  285.                   if (Req = '?') or (Req = '/') then
  286.                     display_long;
  287.                 until (Req <> '?') and (Req <> '/');
  288.                 if Req = ' ' then
  289.                   Req := SectReq;
  290.               end
  291.           end
  292.       end
  293.   end;
  294.   
  295.   
  296.   
  297.   procedure directory(disp : Boolean);
  298.     { Display file area or library directory }
  299.     
  300.   const
  301.     col_width       = 19;
  302.     
  303.   var
  304.     i, j, k,
  305.     entries, Rows,
  306.     mm, ss,
  307.     col_limit,
  308.     line_count      : Integer;
  309.     size            : LongInt;
  310.     This            : FilePtr;
  311.     nodes           : array[1..4] of FilePtr;
  312.     st              : Str10;
  313.     fn              : DosFileName;
  314.     show_dir        : Boolean;
  315.     
  316.   begin
  317.     show_dir := disp;
  318.     abort := False;
  319.     col_limit := max(1, user_rec.columns div col_width);
  320.     if show_dir then
  321.       WriteLn(Com, hi);
  322.     new_dir := False;
  323.     if in_library then
  324.       begin
  325.         This := LibBase;
  326.         show_dir := True;
  327.         entries := LibEntries;
  328.         if show_dir then
  329.           if entries = 0 then
  330.             WriteLn(Com, '   Library: ', LibReq, ' is empty.')
  331.           else
  332.             WriteLn(Com, yellow, '   Library: ', LibReq, '   Files: ', entries, '   Space used: ',
  333.               LibSpace, 'k')
  334.       end
  335.     else if in_arc then
  336.       begin
  337.         This := ArcBase;
  338.         show_dir := True;
  339.         entries := ArcEntries;
  340.         if show_dir then
  341.           if entries = 0 then
  342.             WriteLn(Com, '   Arc File: ', ArcReq, ' is empty.')
  343.           else
  344.             WriteLn(Com, yellow, '   Arc File: ', ArcReq, '   Files: ', entries, '   Space used: ',
  345.               ArcSpace, 'k')
  346.       end
  347.     else
  348.       begin
  349.         This := DirBase;
  350.         entries := DirEntries;
  351.         if show_dir then
  352.           if entries = 0 then
  353.             WriteLn(Com, '   File area: ', SectReq, ' is empty.')
  354.           else
  355.             Write(Com, yellow, '   File area: ', SectReq, '   Files: ', entries, '   Space used: ',
  356.               DirSpace, 'k');
  357.         if (user_rec.access >= 250) and show_dir then
  358.           WriteLn(Com, '   Free: ', free_space, 'k')
  359.         else if show_dir then
  360.           WriteLn(Com);
  361.       end;
  362.     line_count := 2;
  363.     if show_dir then
  364.       Write(Com, cyan);
  365.     if (entries > 0) and show_dir then
  366.       begin
  367.         Rows := entries div col_limit;
  368.         if 0 <> entries mod col_limit then
  369.           Inc(Rows);
  370.         nodes[1] := This;
  371.         for i := 2 to col_limit do
  372.           begin
  373.             for J := 1 to Rows do
  374.               This := This^.next;
  375.             nodes[i] := This
  376.           end;
  377.         i := 1;
  378.         while (not brk) and (i <= Rows) do
  379.           begin
  380.             for J := 1 to col_limit do
  381.               begin
  382.                 This := nodes[J];
  383.                 if (i+Rows*Pred(J)) <= entries then
  384.                   begin
  385.                     if st_switch then
  386.                       begin
  387.                         size := This^.fsize shr 3;
  388.                         if (This^.fsize mod 8) <> 0 then
  389.                           Inc(size);
  390.                         st := intstr(size, 4)+'k '
  391.                       end
  392.                     else
  393.                       begin
  394.                         send_time(This^.fsize, mm, ss);
  395.                         st := intstr(mm, 3)+':'+intstr(ss, 2);
  396.                         for K := 3 to Length(st) do
  397.                           if st[K] = ' ' then
  398.                             st[K] := '0'
  399.                       end;
  400.                     fn := This^.fname;
  401.                     if test_bit(This^.attrib, 1) then
  402.                       begin
  403.                         fn[9] := '*'; { Indicate $SYS file }
  404.                         Write(Com, low, green, fn, st, hi, cyan)
  405.                       end
  406.                     else
  407.                       Write(Com, fn, st);
  408.                     if J < col_limit then
  409.                       Write(Com, dir_fence, ' ')
  410.                     else
  411.                       WriteLn(Com)
  412.                   end
  413.                 else
  414.                   WriteLn(Com);
  415.                 nodes[J] := nodes[J]^.next { Go to next on list }
  416.               end;
  417.             if user_rec.lines <> 99 then
  418.               begin
  419.                 Inc(line_count);
  420.                 if line_count mod user_rec.lines = 0 then
  421.                   pause
  422.               end;
  423.             Inc(i)
  424.           end
  425.       end;
  426.     if (J <> col_limit) and show_dir then
  427.       WriteLn(Com)
  428.   end;
  429.   
  430.   
  431. end.                              { of FILEMNU1.PAS }
  432. 
  433.